home *** CD-ROM | disk | FTP | other *** search
- /**************************************************************************/
- /* $VER: ASpell.ann 2.2 (10 May 1996) */
- /* The AlphaSpell GUI © Copyright Fergus Duniho 1995-6 */
- /**************************************************************************/
-
- OPTIONS RESULTS
- OPTIONS FAILAT 20
- SIGNAL ON SYNTAX
- SIGNAL ON FAILURE
- ARG options
-
- CALL OpenLib("rexxsupport.library")
- CALL OpenLib("rexxtricks.library")
- IF REXXTRICKSVERSION() < "38.6" THEN EXIT
-
- GUI = "AlphaSpell:ASpell.gui"
- PSC = GetScreen()
- EditPort = GetEditPort()
-
- tempfile = "T:Temp" || TIME(s)
- win.title = "Select a Word:"
- win.gadgettext = "_Accept|_Cancel"
- win.pubscreen = PSC
- win.width = 40
- win.sort = "FALSE"
- win.multiselect = "FALSE"
-
- CALL Spellcheck()
- CALL Cleanup()
- EXIT
-
- /**************************************************************************/
- /* SetUp() -- Opens command hosts, etc. */
- /**************************************************************************/
-
- SpellCheck:
-
- /**************************************************************************/
- /* Launch AlphaSpell */
- /**************************************************************************/
-
- IF Show("P", "ALPHASPELL") ~= 1 THEN DO
- ADDRESS COMMAND "run >NIL: AlphaSpell:AlphaSpell AREXX"
- ADDRESS COMMAND "WaitForPort ALPHASPELL"
- shutdown = 1
- END
- ELSE shutdown = 0
-
- IF SHOW("P", "ALPHASPELL") = 0 THEN RETURN
-
- /**************************************************************************/
- /* Launch Varexx */
- /**************************************************************************/
-
- /* Check Varexx is loaded if not load it */
-
- IF SHOW("P","VAREXX") ~= 1 THEN DO
- ADDRESS COMMAND "run >NIL: varexx"
- ADDRESS COMMAND "WaitForPort VAREXX"
- END
- ADDRESS VAREXX
-
- IF OPENPORT("HOLLY") = 0 THEN DO
- ADDRESS ALPHASPELL ANNOUNCE "Could not open Varexx"
- RETURN
- END
- version
- IF RESULT < 1.6 THEN DO
- ADDRESS ALPHASPELL ANNOUNCE "You need version 1.6+ of Varexx"
- RETURN
- END
- "load" GUI "HOLLY PS" PSC
- vhost = RESULT
- ADDRESS VALUE vhost
-
- IF EditPort ~= "" THEN ADDRESS VALUE EditPort
- ADDRESS
-
- /**************************************************************************/
- /* Localize gadget text for chosen language */
- /**************************************************************************/
-
- lang = GetENV("language")
- IF lang ~= "" & lang ~= "english" THEN DO
- catalog = "AlphaSpell:Catalogs/ASpell." || lang
- IF Exists(catalog) THEN DO
- CALL READFILE catalog, lines
- DO x = 1 to lines.0
- INTERPRET "setlabel" "'"lines.x"'"
- END
- END
- END
-
- /**************************************************************************/
- /* Show About screen while AlphaSpell checks document. */
- /**************************************************************************/
-
- show about
-
- ADDRESS ALPHASPELL WHO
- name = RESULT
- IF name ~= "" THEN settext share name
- CALL ReadPrefs()
- IF Pos("CLIP", options) > 0 THEN DO
- CALL READCLIPBOARD "0", "lines"
- CALL WRITEFILE tempfile, "lines"
- END
- ELSE CALL SaveTemp()
-
- /**************************************************************************/
- /* Spell check tempfile with AlphaSpell */
- /**************************************************************************/
-
- IF Pos("TEX", options) > 0 THEN switches = "TEX"
- ELSE switches = ""
- ADDRESS ALPHASPELL "CHECK" tempfile tempfile "PATH" dict_path dict_list switches
-
- /**************************************************************************/
- /* Set Lists */
- /**************************************************************************/
-
- CALL ReadList "UNFOUND"
- IF UNFOUND.0 = 0 THEN DO
- ADDRESS ALPHASPELL ANNOUNCE "Spell Checking Finished:\n\nNo Misspellings Found\n"
- RETURN
- END
- current = 1
- LWORDS.0 = 0
- MWORDS.0 = 0
-
- hide
- show main
- IF name = "" THEN setbar ed max 2
- window front activate
- CALL SetTarget UNFOUND.1
-
- /**************************************************************************/
- /* MAIN LOOP -- Check for GUI events */
- /**************************************************************************/
-
- DO FOREVER
- CALL WAITPKT("HOLLY")
- packet = GETPKT("HOLLY")
- IF packet ~= '00000000'x THEN DO
- class = GETARG(packet)
- SELECT
- WHEN class = "CLOSEWINDOW" THEN LEAVE
- WHEN class = "LEARN" THEN CALL Learn()
- WHEN class = "FIND" THEN flag = FindWord(flag)
- WHEN class = "REPLACE" THEN CALL ReplaceWord()
- WHEN class = "GUESS" THEN CALL Guess()
- WHEN class = "NEXT" THEN CALL SetTarget("+1")
- WHEN class = "PREV" THEN CALL SetTarget("-1")
- WHEN class = "FIRST" THEN CALL SetTarget(1)
- WHEN class = "LAST" THEN CALL SetTarget(UNFOUND.0)
- WHEN class = "SELECT" THEN CALL ChooseWord()
- WHEN Word(class, 1) = "METHOD" THEN DO
- IF Word(class, 2) = "0" THEN set ed enable
- ELSE set ed disable
- END
- WHEN class = "PREFS" THEN DO
- CALL Preferences()
- CALL SetTarget(current)
- IF name = "" THEN setbar ed max 2
- END
- OTHERWISE NOP
- END
- window front activate
- END
- END
- IF LWORDS.0 + MWORDS.0 > 0 THEN DO
- hide
- show learn
- CALL QSORT "LWORDS"
- LWORDS.count = LWORDS.0
- setlist lwords clear stem LWORDS select LWORDS.1
- CALL QSORT "MWORDS"
- MWORDS.count = MWORDS.0
- setlist mwords clear stem MWORDS select MWORDS.1
- DO FOREVER
- CALL WAITPKT("HOLLY")
- packet = GETPKT("HOLLY")
- IF packet ~= '00000000'x THEN DO
- class = GETARG(packet)
- SELECT
- WHEN class = "CLOSEWINDOW" THEN LEAVE
- WHEN class = "SAVEWORDS" THEN DO
- CALL SaveList()
- LEAVE
- END
- WHEN class = "MOVE" THEN CALL Move()
- WHEN class = "RML" THEN CALL Lose("lwords")
- WHEN class = "RMM" THEN CALL Lose("mwords")
- OTHERWISE NOP
- END
- window front activate
- END
- END
- END
- ADDRESS
- RETURN
-
- /**************************************************************************/
- /* VARIOUS SUBROUTINES */
- /**************************************************************************/
-
- /**************************************************************************/
- /* SetTarget(word) -- Sets the word in the target string gadget */
- /**************************************************************************/
-
- SetTarget:
- IF DATATYPE(arg(1)) = "NUM" THEN DO
- IF VERIFY(arg(1), "+-", "M") = 1 THEN current = current + arg(1)
- ELSE current = arg(1)
- IF current < 1 THEN current = UNFOUND.0
- IF current > UNFOUND.0 THEN current = 1
- settext target UNFOUND.current
- settext replacement UNFOUND.current
- END
- ELSE DO
- settext target arg(1)
- settext replacement arg(1)
- END
- flag = 0 /* Word hasn't been searched for since selection */
- RETURN
-
- /**************************************************************************/
- /* SetReplace() - Sets replacement string gadget */
- /**************************************************************************/
-
- SetReplace:
- settext replacement arg(1)
- settext target UNFOUND.current
- RETURN
-
- /**************************************************************************/
- /* Learn() -- Adds a word to LEARN, the words to learn list */
- /**************************************************************************/
-
- Learn:
- read target
- wrd = RESULT
- /* Tests whether wrd is lowercase */
- IF BITOR(wrd,," ") == wrd THEN DO
- IF LSEARCH(wrd, "LWORDS") == -1 THEN DO
- cnt = LWORDS.0 + 1
- LWORDS.0 = cnt
- LWORDS.cnt = wrd
- END
- END
- ELSE DO
- cur = LSEARCH(wrd, "MWORDS")
- DO WHILE (MWORDS.cur = wrd) & (MWORDS.cur ~== wrd)
- cur = cur + 1
- END
- IF cur == -1 THEN DO
- cnt = MWORDS.0 + 1
- MWORDS.0 = cnt
- MWORDS.cnt = wrd
- END
- END
- CALL SetTarget("+1")
- RETURN
-
- /**************************************************************************/
- /* Guess() has AlphaSpell search for anagrams, matches, or guesses */
- /**************************************************************************/
-
- Guess:
- busy set
- read method
- mode = RESULT
- read replacement
- targ = RESULT
- SELECT
- WHEN mode = 0 THEN DO
- read ed
- op = "ED" RESULT
- END
- WHEN mode = 2 THEN op = "ANAGRAMS"
- WHEN mode = 3 THEN op = "CASE"
- OTHERWISE op = ""
- END
-
- ADDRESS ALPHASPELL "MATCH" targ op "TO" tempfile "PATH" dict_path dict_list
- CALL ReadList "GUESS"
- busy
- IF GUESS.0 > 0 THEN DO
- IF VIEWLIST("GUESS", "win", "dest") = 1 THEN CALL SetReplace(dest.1)
- END
- ELSE ADDRESS ALPHASPELL ANNOUNCE "Search Complete:\n\nNo Match Found\n"
- RETURN
-
- /**************************************************************************/
- /* ChooseWord() -- Select word from listview of unfound words */
- /**************************************************************************/
-
- ChooseWord:
- IF VIEWLIST("UNFOUND", "win", "dest") = 1 THEN CALL SetTarget(dest.1)
- IF dest.1 ~= "" THEN DO
- current = LSEARCH(dest.1, "UNFOUND")
- uwrd = UPPER(dest.1)
- DO WHILE (UPPER(UNFOUND.current) = uwrd) & (UNFOUND.current ~= dest.1)
- current = current + 1
- END
- END
- RETURN
-
- /**************************************************************************/
- /* SaveList() -- Saves words in the "LEARN" list to user dictionary */
- /**************************************************************************/
-
- SaveList:
- udict.low = MAKEPATH(dict_path, user_dict || ".ald")
- udict.mix = MAKEPATH(dict_path, user_dict || ".amd")
- read lwords LEARN
- LEARN.0 = LEARN.count
- IF LEARN.0 > 0 THEN DO
- CALL WRITEFILE tempfile, "LEARN"
- ADDRESS ALPHASPELL "ADD FROM" tempfile "TO" udict.low
- END
- read mwords LEARN
- LEARN.0 = LEARN.count
- IF LEARN.0 > 0 THEN DO
- CALL WRITEFILE tempfile, "LEARN"
- ADDRESS ALPHASPELL "ADD FROM" tempfile "TO" udict.mix
- END
- CALL DELETE tempfile
- RETURN
-
- /**************************************************************************/
- /* Move() -- Moves word from mixed case listview to lowercase listview */
- /**************************************************************************/
-
- Move:
- setlist lwords BITOR(Lose("mwords"),," ")
- RETURN
-
- /**************************************************************************/
- /* ReadList -- Reads words from tempfile to a list and sorts the list */
- /**************************************************************************/
-
- ReadList:
- CALL READFILE tempfile, arg(1)
- INTERPRET arg(1) || ".count =" arg(1) || ".0"
- CALL QSORT arg(1)
- RETURN
-
- /**************************************************************************/
- /* Lose() -- Deletes a word from a listview */
- /**************************************************************************/
-
- Lose:
- INTERPRET "read" arg(1) boo
- wrd = RESULT
- INTERPRET "setlist" arg(1) "wrd del"
- item = boo.select
- IF item = boo.count THEN item = item - 1
- INTERPRET "setlist" arg(1) "select s update" item
- RETURN wrd
-
- /**************************************************************************/
- /* Preferences() -- Preferences GUI */
- /**************************************************************************/
-
- Preferences:
-
- hide
- show prefs
- IF ~GetDir("AlphaSpell:Dict/", "#?", "langs", "D", "N") THEN RETURN
- CALL QSORT "langs"
- langs.count = langs.0
- setlist language clear stem langs
- IF LSEARCH(lang, langs) = -1 THEN setlist language langs.1
- ELSE setlist language select lang
- settext dict dict_list
- settext udict user_dict
- DO FOREVER
- CALL WAITPKT("HOLLY")
- packet = GETPKT("HOLLY")
- IF packet ~= '00000000'x THEN DO
- class = GETARG(packet)
- SELECT
- WHEN class = "CLOSEWINDOW" | class = "CANCEL" THEN LEAVE
- WHEN class = "SAVE" | class = "USE" THEN DO
- read language
- lang = RESULT
- dict_path = "AlphaSpell:Dict/" || lang || "/"
- read dict
- dict_list = RESULT
- read udict
- user_dict = RESULT
- IF class = "SAVE" THEN CALL WritePrefs
- LEAVE
- END
- OTHERWISE NOP
- END
- END
- END
- hide
- show main
- RETURN
-
- /**************************************************************************/
- /* WritePrefs() -- Writes Preferences to Icon */
- /**************************************************************************/
-
- WritePrefs:
- CALL SETTOOLTYPEVALUE GUI, "LANG", lang
- CALL SETTOOLTYPEVALUE GUI, "DICT", dict_list
- CALL SETTOOLTYPEVALUE GUI, "USER", user_dict
- RETURN
-
- /**************************************************************************/
- /* ReadPrefs() -- Read Preferences from ENV:ASpell.prefs or use defaults */
- /**************************************************************************/
-
- ReadPrefs:
- lang = GETTOOLTYPEVALUE(GUI, "LANG")
- dict_path = "AlphaSpell:Dict/" || lang || "/"
- dict_list = GETTOOLTYPEVALUE(GUI, "DICT")
- user_dict = GETTOOLTYPEVALUE(GUI, "USER")
- IF ~Exists(dict_path) THEN DO
- ADDRESS ALPHASPELL ANNOUNCE dict_path "doesn't exist."
- CALL Preferences()
- show about
- END
- RETURN
-
- /**************************************************************************/
- /* Cleanup() -- Closes down the GUI */
- /**************************************************************************/
-
- Cleanup:
- IF SHOWLIST("P", "HOLLY") = 1 THEN CALL CLOSEPORT ("HOLLY")
- IF SHOWLIST("P", "VAREXX") = 1 THEN ADDRESS "VAREXX" hide unload
- IF SHOWLIST("P", "ALPHASPELL") = 1 & shutdown = 1 THEN ADDRESS ALPHASPELL QUIT
- RETURN
-
- /**************************************************************************/
- /* OpenLib(library) -- Checks that library exists and opens it if it does */
- /**************************************************************************/
-
- OpenLib: PROCEDURE
-
- IF EXISTS("libs:" || arg(1)) THEN DO
- IF ~SHOW("L", arg(1)) THEN
- IF ~ADDLIB(arg(1),0,-30,0) THEN EXIT
- END
- ELSE EXIT
- RETURN
-
- /**************************************************************************/
- /* ERROR MESSAGES */
- /**************************************************************************/
-
- failure:
- syntax:
- SAY "Error" rc "-- Line" SIGL
- SAY errortext(rc)
- SAY sourceline(SIGL)
- CALL Cleanup()
- EXIT
-
- /**************************************************************************/
- /* Functions to get around the limits of some text editors. You might or */
- /* might not need some of these. */
- /**************************************************************************/
-
- /**************************************************************************/
- /* WordComp(string, word) -- Checks whether a target word can be parsed */
- /* from a given string. This is useful if your text editor lacks a whole */
- /* word search mode. You can search for a word, read the full text of the */
- /* found string, and compare them. */
- /**************************************************************************/
-
- WordComp: PROCEDURE
- Parse Arg str, wrd, x
- s = Index(str, wrd, x)
- IF s = 0 THEN RETURN 0
- IF s>1 THEN DO
- c = Substr(str, s-1, 1)
- IF Datatype(c, "A") = 1 | c = "'" THEN RETURN 0
- END
- s = s + Length(wrd)
- IF s > Length(str) THEN RETURN 1
- c = Substr(str, s, 1)
- IF Datatype(c, "M") = 1 THEN RETURN 0
- RETURN 1
- END
-
- /**************************************************************************/
- /* EDITOR SPECIFIC SUBROUTINES */
- /**************************************************************************/
-
- /**************************************************************************/
- /* FindWord(flag) -- Finds selected word in document */
- /**************************************************************************/
-
- FindWord: PROCEDURE
- read target
- wrd = RESULT /* Reads selected word */
- ADDRESS
- IF arg(1) = 0 THEN MOVE_CURSOR ABS 0 0
- SET FIND_TEXT wrd
- DOMENU FIND_NEXT
- ADDRESS
- RETURN 1
-
- /**************************************************************************/
- /* ReplaceWord() -- Replaces selected word with word in string gadget */
- /**************************************************************************/
-
- ReplaceWord:
- read target
- oldword = RESULT
- read replacement
- newword = RESULT
- ADDRESS
- DEL Length(oldword)
- INSERT STRING newword
- ADDRESS
- RETURN
-
- /**************************************************************************/
- /* SaveTemp() -- Saves the current file as a temporary file */
- /**************************************************************************/
-
- SaveTemp:
- ADDRESS
- DOMENU SELECT_ALL
- DOMENU COPY 0
- ADDRESS
- CALL READCLIPBOARD "0", "lines"
- CALL WRITEFILE tempfile, "lines"
- RETURN
-
- /**************************************************************************/
- /* GetEditPort() -- Makes sure the right text editor port is open. */
- /**************************************************************************/
-
- GetEditPort:
- IF Abbrev(Address(), "Annotate_Rexx") = 1 THEN RETURN Address()
- IF ~SHOWLIST("P", "Annotate_Rexx") THEN DO
- CALL rtezrequest "Annotate_Rexx unavailable", "_Abort", "Missing Port:"
- EXIT
- END
- RETURN "Annotate_Rexx"
-
- /**************************************************************************/
- /* GetScreen() -- Returns the screen name */
- /**************************************************************************/
-
- GetScreen: PROCEDURE
- RETURN GETDEFAULTPUBSCREEN()
-
-